home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / scm / xscm.lha / xscm / assert.scm next >
Encoding:
Text File  |  1992-08-29  |  1.2 KB  |  48 lines
  1. ; $Header: /home/campbell/Languages/Scheme/scm/x-scm/RCS/assert.scm,v 1.1 1992/07/03 03:06:52 campbell Beta $
  2. ;
  3. ; Assertion checking macro
  4. ;
  5. ; Usage:
  6. ;
  7. ;    #.(assert 'expr . args)
  8. ;
  9. ; Prints a message and aborts if expr evalutes to #f.  Optional args
  10. ; are also printed.
  11. ;
  12. ; If you want to disable (most of) this for performance after things
  13. ; are debugged, just define assert:disabled to #t.
  14. ;
  15. ;  Author: Larry Campbell (campbell@redsox.bsw.com)
  16. ; 
  17. ;  Copyright 1992 by The Boston Software Works, Inc.
  18. ;  Permission to use for any purpose whatsoever granted, as long
  19. ;  as this copyright notice remains intact.  Please send bug fixes
  20. ;  or enhancements to the above email address.
  21.  
  22. (require 'format)
  23.  
  24. (define assert:disabled #f)
  25.  
  26. (define (assert condition . args)
  27.   (let ((e (format #f "Assertion failed: ~A~%" condition)))
  28.     (if assert:disabled
  29.     #t
  30.     `(if (not ,condition)
  31.          (let ((msg ,e))
  32.            ,(if (not (null? args))
  33.             `(set!
  34.               msg
  35.               (string-append
  36.                msg
  37.                ,@(map
  38.               (lambda (a)
  39.                 `(format #f "    ~A=~A~%" ',a ,a))
  40.               args))))
  41.            (if ,*load-pathname*
  42.            (set!
  43.             msg
  44.             (string-append
  45.              msg (format #f "  In file ~A, line ~A"
  46.                  ,*load-pathname* ,(line-number)))))
  47.            (error msg))))))
  48.